home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
pcboard
/
lnrpcb20.zip
/
LINERS.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1996-04-27
|
8KB
|
482 lines
;------------------------------------------------------------------------------
; .ss.
; `²²'
; .,sS$Ss,,s$ .,sS$$$Ss. .,sS$Ss,,s$ .ss. .sSs.
; .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
; $$$' .$$$' $$$²Sçsµ²' .$$$' .$$$'.$$$' .$$$' `$$b.
; $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$' ;$$$
; `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
; .sS²°$$$²²°"' d²°'
; .$$² .$$'
; $$$.,d$$'
; `²S$$S²'
;------------------------------------------------------------------------------
; P.P.L.X. 2.OO (C)1996 - Lone Runner / AEGiS CoRP'96
;------------------------------------------------------------------------------
; PPE 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Integer INTEGER003
Integer INTEGER004
Integer INTEGER005
Integer INTEGER006
Integer INTEGER007
Integer INTEGER008
String STRING004
String STRING005
String STRING006
String STRING007
String STRING008
String STRING009
String STRING010
String STRING011
String STRING012
String STRING013
String STRING014
String STRING015
String STRING016
String STRING017
String STRING018
String STRING019
String STRING020
String STRING021
String STRING022
String STRING023
String STRING024
String STRING025
String TSTRING026(250)
Declare Procedure PROC001()
Declare Procedure PROC002(Var String STRING001, Var String STRING002, Var String STRING003)
Declare Procedure PROC003()
;------------------------------------------------------------------------------
Goto LABEL001
End
;------------------------------------------------------------------------------
Procedure PROC001()
Integer INTEGER001
Integer INTEGER002
Byte BYTE001
INTEGER001 = GetDrive()
INTEGER002 = Os()
FOpen 1, PPEPath() + "LINERS.TXT", 0, 2
BYTE001 = FTell(1)
FClose 1
EndProc
;------------------------------------------------------------------------------
Procedure PROC002(Var String STRING001, Var String STRING002, Var String STRING003)
STRING001 = "NO"
STRING002 = "UNREGISTERED"
STRING003 = "UNREGISTERED"
EndProc
;------------------------------------------------------------------------------
Procedure PROC003()
Color 0
Cls
AnsiPos 25, 10
Print "@X0FSHAREWARE EVALUATION VERSION"
AnsiPos 20, 12
Print "@X0ECopyright 1995,96 (c) Shuttle Software"
AnsiPos 30, 14
Print "@X0EAll Rights Reserved"
Delay 55
EndProc
:LABEL001
INTEGER003 = 0
INTEGER004 = 0
INTEGER006 = 0
INTEGER005 = 16
INTEGER007 = 0
INTEGER008 = 10
STRING004 = "@X0A"
STRING005 = "@X0F"
STRING007 = ""
STRING010 = ""
STRING009 = "N"
STRING011 = "N"
STRING012 = "Y"
STRING014 = ""
STRING015 = ""
STRING016 = ""
STRING017 = ""
STRING018 = ""
STRING019 = ""
STRING020 = "YES"
STRING013 = "YES"
STRING008 = "NO"
STRING006 = "NO"
STRING023 = ""
STRING024 = ""
STRING025 = ""
PROC001()
STRING022 = PPEPath() + "ANSI.CFG"
If (Exist(STRING022)) Then
FOpen 1, STRING022, 0, 2
FGet 1, STRING013
FClose 1
Endif
If (STRING013 <> "NO") Then
If (AnsiOn()) Then
PROC002(STRING023, STRING025, STRING024)
Log "-=≡[ Liners Entered ]≡=-", 0
Else
PrintLn "This program requires that your ANSI support is enabled!"
Wait
End
Endif
Else
PROC002(STRING023, STRING025, STRING024)
Log "-=≡[ Liners Entered ]≡=-", 0
Endif
STRING021 = PPEPath() + "LINERS.CFG"
If (Exist(STRING021)) Then
FOpen 1, STRING021, 0, 2
FGet 1, INTEGER005
FGet 1, STRING020
FGet 1, STRING006
FClose 1
Endif
If (INTEGER005 > 100) INTEGER005 = 100
If (Upper(STRING006) <> "YES") Then
Gosub LABEL005
PrintLn "@X00"
Print "@X0EWould you like to add a Liner [@X0FY@X0E/@X0FN@X0E]"
InputText " ", STRING011, 15, 1
If (Upper(STRING011) == "Y") Then
Gosub LABEL010
Gosub LABEL011
Endif
Else
PrintLn "@X00"
PrintLn "@X0EWould you like to view the Liners [@X0FY@X0E/@X0FN@X0E]"
STRING009 = TInkey(73)
If (Upper(STRING009) == "Y") Then
Gosub LABEL005
PrintLn "@X00"
Print "@X0EWould you like to add a Liner [@X0FY@X0E/@X0FN@X0E]"
InputText " ", STRING011, 15, 1
If (Upper(STRING011) == "Y") Then
Gosub LABEL010
Gosub LABEL011
Endif
Else
PrintLn "@X00"
PrintLn "@X0CGuess not..."
Delay 27
Endif
Endif
PROC003()
End
:LABEL002
STRING007 = "NO"
STRING016 = PPEPath() + "FILTER.TXT"
If (Exist(STRING016)) Then
FOpen 1, STRING016, 0, 2
:LABEL003
If (Ferr(1)) Goto LABEL004
FGet 1, STRING010
INTEGER004 = InStr(Upper(STRING018), Upper(STRING010))
If (INTEGER004 > 0) Then
STRING007 = "YES"
Goto LABEL004
Endif
Goto LABEL003
:LABEL004
FClose 1
Endif
Return
:LABEL005
INTEGER006 = 0
INTEGER007 = 1
STRING018 = ""
STRING008 = "NO"
STRING015 = PPEPath() + "LINERS.TXT"
If (Exist(STRING015)) Then
If (Upper(STRING020) <> "NO") Then
FOpen 1, STRING015, 0, 2
FGet 1, STRING018
:LABEL006
If (Ferr(1)) Goto LABEL007
INTEGER006 = INTEGER006 + 1
TSTRING026(INTEGER006) = STRING018
If (INTEGER006 == INTEGER005) Goto LABEL007
FGet 1, STRING018
Goto LABEL006
:LABEL007
FClose 1
Else
FOpen 1, STRING015, 0, 2
FGet 1, STRING018
:LABEL008
If (Ferr(1)) Goto LABEL009
INTEGER006 = INTEGER006 + 1
TSTRING026(INTEGER006) = STRING018
If (INTEGER006 > 249) Goto LABEL009
FGet 1, STRING018
Goto LABEL008
:LABEL009
FClose 1
Endif
Else
PrintLn "@X00"
PrintLn "@X0CATTENTION SYSOP: The file LINERS.TXT is missing!"
PrintLn "@X00"
Wait
End
Endif
While (STRING008 <> "YES") Do
Color 0
Cls
PrintLn "@X0B▐@X1B ┌─────────────────────────────────────────────────────────────────────────@X10┐@X1B @X08▌@X0B"
PrintLn "@X0B▐@X1B │@X1E LINERS v2.0 @X1FRegistered To@X17: @X10│@X1B @X08▌@X0B"
PrintLn "@X0B▐@X1B └@X10─────────────────────────────────────────────────────────────────────────┘@X1B @X08▌@X0B"
AnsiPos 47, 2
Print "@X1F", STRING024
AnsiPos 1, 4
PrintLn "@X00"
Color 10
If (Upper(STRING020) <> "NO") Then
For INTEGER003 = 1 To 16
If (INTEGER007 <= INTEGER006) Then
PrintLn TSTRING026(INTEGER007)
INTEGER007 = INTEGER007 + 1
Continue
Endif
STRING008 = "YES"
Break
Next
Else
For INTEGER003 = 1 To 15
If (INTEGER007 <= INTEGER006) Then
PrintLn TSTRING026(INTEGER007)
INTEGER007 = INTEGER007 + 1
Continue
Endif
STRING008 = "YES"
Break
Next
Endif
If (INTEGER007 >= INTEGER006) STRING008 = "YES"
If (STRING008 <> "YES") Then
PrintLn
Wait
Endif
EndWhile
Return
:LABEL010
Color 0
Cls
AnsiPos 1, 10
PrintLn "@X0E Pick the @X0F# @X0Eof the Color you would like your Liner to be..."
PrintLn "@X00"
PrintLn "@X01 ██ @X02██ @X03██ @X04██ @X05██ @X06██ @X07██ @X08██ @X09██ @X0A██ @X0B██ @X0C██ @X0D██ @X0E██ @X0F██"
PrintLn "@X0F 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15"
PrintLn "@X00"
Print "@X0E Enter the [@X0F#@X0E]"
InputInt " ", INTEGER008, 15
Select Case (INTEGER008)
Case 1
STRING004 = "@X01"
Case 2
STRING004 = "@X02"
Case 3
STRING004 = "@X03"
Case 4
STRING004 = "@X04"
Case 5
STRING004 = "@X05"
Case 6
STRING004 = "@X06"
Case 7
STRING004 = "@X07"
Case 8
STRING004 = "@X08"
Case 9
STRING004 = "@X09"
Case 10
STRING004 = "@X0A"
Case 11
STRING004 = "@X0B"
Case 12
STRING004 = "@X0C"
Case 13
STRING004 = "@X0D"
Case 14
STRING004 = "@X0E"
Case 15
STRING004 = "@X0F"
End Select
Return
:LABEL011
STRING017 = ""
STRING018 = ""
While (Upper(STRING014) <> "Y") Do
STRING014 = ""
Color 0
Cls
AnsiPos 1, 8
PrintLn "@X1B▌┌───────────────────────────────────────────────────────────────────────────@X10┐@X18▐@X1B"
PrintLn "@X1B▌│@X1E LINERS v2.0 @X10│@X18▐@X1B"
PrintLn "@X1B▌│@X1E @X10│@X18▐@X1B"
PrintLn "@X1B▌│@X1A Please Enter Your Liner Below @X10│@X18▐@X1B"
PrintLn "@X1B▌│@X1E @X10│@X18▐@X1B"
PrintLn "@X1B▌│@X1E @X10│@X18▐@X1B"
PrintLn "@X1B▌└@X10───────────────────────────────────────────────────────────────────────────┘@X18▐@X07"
AnsiPos 3, 13
Print Space(75)
AnsiPos 3, 13
InputText " ", STRING018, 15, 70
If (STRING018 == "") Then
PROC003()
End
Endif
AnsiPos 1, 16
Print "@X0EIs the above Liner what you want to add [@X0FY@X0E]es, [@X0FN@X0E]o, [@X0FQ@X0E]uit"
InputText " ", STRING014, 15, 1
If (Upper(STRING014) == "Q") Then
PROC003()
End
Endif
EndWhile
If (Upper(STRING020) <> "NO") Then
TSTRING026(INTEGER006 + 1) = STRING004 + STRING018
Else
STRING017 = STRING004 + STRING018
Endif
Gosub LABEL002
If (STRING007 == "NO") Then
If (Upper(STRING020) <> "NO") Then
FCreate 1, STRING015, 1, 3
If (INTEGER006 < INTEGER005) Then
For INTEGER003 = 1 To INTEGER006 + 1
FPutLn 1, TSTRING026(INTEGER003)
Next
Else
For INTEGER003 = 2 To INTEGER006 + 1
FPutLn 1, TSTRING026(INTEGER003)
Next
Endif
FClose 1
Else
STRING019 = STRING005 + U_Name() + " said the following..."
FAppend 1, STRING015, 1, 3
FPutLn 1, STRING019
FPutLn 1, STRING017
FPutLn 1
FClose 1
Endif
AnsiPos 1, 18
PrintLn "@X0AYour Liner Was Added!"
Log "ADDED: " + STRING018, 0
PrintLn "@X00"
Print "@X0EView the Liners again [@X0FY@X0E/@X0FN@X0E]"
InputText " ", STRING012, 15, 1
If (Upper(STRING012) == "Y") Then
Gosub LABEL005
PrintLn "@X00"
Wait
Endif
Else
Log "REJECTED: " + STRING018, 0
Log "FOUND: " + Upper(STRING010), 0
Color 0
Cls
AnsiPos 11, 11
PrintLn "@X0CYour liner contains unacceptable language! Shame on you..."
PrintLn "@X00"
PrintLn "@X00"
PrintLn "@X00"
Wait
Endif
Return
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 6 End
; 5 Cls
; 5 Wait
; 6 Color
; 89 Goto
; 83 Let
; 10 Print
; 36 PrintLn
; 51 If
; 1 FCreate
; 6 FOpen
; 1 FAppend
; 8 FClose
; 9 FGet
; 5 FPutLn
; 5 Log
; 1 InputInt
; 8 Gosub
; 4 Return
; 2 Delay
; 5 InputText
; 12 AnsiPos
; 3 EndProc
;
;
; ■ Functions used :
;
; 25 +
; 23 ==
; 9 <>
; 5 <
; 6 <=
; 3 >
; 9 >=
; 47 !
; 8 &&
; 4 ||
; 14 Upper()
; 1 Space()
; 3 Ferr()
; 1 InStr()
; 1 U_Name()
; 5 PPEPath()
; 4 Exist()
; 1 AnsiOn()
; 1 TInkey()
; 1 GetDrive()
; 1 FTell()
; 1 Os()
;
;------------------------------------------------------------------------------
;
; Analysis flags : No flag
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 4 For/Next
; 2 While/EndWhile
; 23 If/Then or If/Then/Else
; 1 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------